home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / utils / inter37d.arj / INTHELP.ARJ / USERINTE.PAS < prev   
Pascal/Delphi Source File  |  1991-10-26  |  9KB  |  235 lines
  1. unit UserInterface;
  2.  
  3. {the fancy user interface}
  4. {if you want to write your own user interface, you should write a unit,
  5.  having the same name and interface as this one and recompile the 
  6.  INTHELP program }
  7.  
  8. interface
  9.   procedure GetFileNames (var InFile, OutFile : String);
  10.     {Is called by INTHELP to retrieve the names of the input (InFile) and 
  11.      output (OutFile) file.}
  12.   procedure StartPass1;
  13.     {Is called by INTHELP prior to starting its first pass on the input 
  14.      file. You could use this procedure (and the following) to keep the 
  15.      user informed about the work that is being done by the program}
  16.   procedure StartPass2;
  17.     {Is called by INTHELP prior to starting the second pass on the input
  18.      file}
  19.   procedure PutLineNumber (Number : LongInt);
  20.     {Is called by INTHELP each time a new line is read from the input file.
  21.      Number specifies the line number of that line.}
  22.   procedure Finished (LastTopic : Word);
  23.     {Is called by INTHELP when it has finished its work.  LastTopic specifies
  24.      the highest topic number used by INTHELP.}
  25.  
  26. implementation
  27. uses DOS, OPDOS, OPPICK, OPSTRING, OPCMD, OPCRT, OPDIR,
  28.      OPENTRY, OPFIELD, OPFRAME, OPROOT, OPSELECT, OPWINDOW;
  29.     {quite a list, isn't it}
  30. const
  31.   LeftX  : Byte = 19;
  32.   RightX : Byte = 60;
  33.   TopY   : Byte = 8;
  34.   BottomY: Byte = 10;
  35.   LinePut: Byte = 3;
  36. var
  37.   InputF, OutputF : String;
  38.     {The names of the input and output file are remembered, so we will be
  39.      able to include them in the information provided by the program
  40.      when giving the user a clue about what the program is doing.}
  41.   Dir             : DirList;
  42.   Display         : RawWindow;
  43.     {The window we'll use to keep the user informed about our whereabouts.}
  44.   LastLine        : LongInt;
  45.     {We keep the last linenumber we've printed, so we can include this 
  46.      information in our INFOwindow}
  47.  
  48.   {Internal Procedures}
  49.  
  50.   {$V-}{$F+}
  51.   procedure PreEdit(ESP : EntryScreenPtr);
  52.   var
  53.     Finished : Boolean;
  54.     {----------------------------------------------------------------}
  55.     procedure InitDir;
  56.     begin
  57.     {Initialize the DIRLIST object which might be used to ask for the }
  58.     {name of the input file                                           }
  59.       if not Dir.InitCustom(20, 15, 69, 24,   {Window coordinates}
  60.                             DefaultColorSet,
  61.                             DefWindowOptions or wBordered,
  62.                             MaxAvail,
  63.                             PickSnaking,      {Pick orientation}
  64.                             SingleFile)       {Command handler}
  65.       then Halt; {Sorry Folks, something went wrong}
  66.       {DirList features}
  67.       Dir.SetDirAttr($1E,AutoMapMono); {Color of a directory name     }
  68.       Dir.AddRejectString('PAS');      {Filenames with the following  }
  69.       Dir.AddRejectString('EXE');      {extensions shouldn't be shown }
  70.       Dir.AddRejectString('COM');
  71.       Dir.AddRejectString('BIN');
  72.       Dir.AddRejectString('BAK');
  73.       Dir.AddRejectString('TPU');
  74.       Dir.SetRejectFunc(RejectExtensions);
  75.       Dir.SetPadSize(1, 1);
  76.       Dir.diOptionsOn(diOptimizeSize);
  77.       Dir.wFrame.AddHeader(' Select a File ', heTC);
  78.       Dir.SetSortOrder(SortDirName);   {Sort order : first directories
  79.                                                      then filenames   }
  80.       Dir.SetNameFormat;               {Show filenames only           }
  81.       Dir.SetMask('*.*', ReadOnly+Directory+Archive);
  82.     end{InitDir};
  83.     {----------------------------------------------------------------}
  84.   begin
  85.     case ESP^.GetCurrentID of
  86.       0 : begin {Field 0 = entry field for filename of inputfile}
  87.             if not ExistFile (InputF) then begin
  88.                 {specified filename doesn't exist}
  89.               InitDir;
  90.               ESP^.wFastWrite('Specify existing input file', 4, 7, TextAttr);
  91.               Finished := False;
  92.               repeat
  93.                 Dir.Process;
  94.                 case Dir.GetLastCommand of
  95.                   ccSelect :
  96.                     begin
  97.                       InputF   := Dir.GetSelectedPath;
  98.                       Finished := True;
  99.                     end;
  100.                   ccError  :
  101.                     begin              
  102.                       Finished := True;
  103.                     end;               
  104.                   ccQuit   :
  105.                     Finished := True;
  106.                 end;{case}
  107.               until Finished;
  108.               Dir.Done;
  109.             end;{if}
  110.             ESP^.DrawField(0);
  111.           end{block};
  112.       1 : ESP^.wFastWrite('    Specify output file    ', 4, 7, TextAttr);
  113.     end {case};
  114.   end;
  115.   {------------------------------------------------------------------}
  116.   procedure PostEdit (ESP:EntryScreenPtr);
  117.   begin
  118.     case ESP^.GetCurrentId of
  119.       0: ;
  120.       1: if ExistFile (InputF) then
  121.            ESP^.SetLastCommand(ccQuit);
  122.     end;
  123.   end;
  124.   {------------------------------------------------------------------}
  125.   {$F-}
  126.   procedure GetTheNames;
  127.   var
  128.     ES       : EntryScreen;
  129.     Finished : Boolean;
  130.   begin
  131.     {Initialize the 'EntryScreen'}
  132.     if not ES.InitCustom(25, 5, 65, 8,     {Window coordinates}
  133.                          DefaultColorSet,  {ColorSet}
  134.                          DefWindowOptions OR wBordered)
  135.     then begin
  136.       WriteLn('Failed to init EntryScreen. Status = ', InitStatus);
  137.       Halt;
  138.     end;
  139.     {add some window frills}
  140.     ES.wFrame.AddShadow(shBR, shOverWrite);
  141.     ES.wFrame.AddHeader(' Enter File Names ', heTC);
  142.     {add fields}
  143.     ES.esFieldOptionsOn(efClearFirstChar);
  144.     ES.AddStringField('Input :', 2,1, '',2,9, 30, 0,InputF);
  145.     ES.AddStringField('Output:', 3,1, '',3,9, 30, 0,OutputF);
  146.     {set procedure pointers}
  147.     ES.SetPreEditProc(PreEdit);
  148.     ES.SetPostEditProc(PostEdit);
  149.     Finished := False;
  150.     while not Finished do begin
  151.       ES.Process;
  152.       case ES.GetLastCommand of
  153.         ccDone, ccQuit : Finished := (ExistFile(InputF) and (OutputF <> ''));
  154.         else
  155.           Finished := True;
  156.       end{case};
  157.     end{while};
  158.     ES.Erase;
  159.     ES.Done;
  160.   end{GetTheNames};
  161.   {$V+}
  162.   {------------------------------------------------------------------}
  163.   {Implementation of external procedures}
  164.   procedure GetFileNames(var InFile, OutFile : String);
  165.   var
  166.     Parameters : String;
  167.   begin
  168.     InputF  := ParamStr (1);
  169.     OutputF := ParamStr (2);
  170.     if ((not ExistFile (InputF)) or (OutputF = '')) then
  171.       GetTheNames;
  172.     InFile  := InputF;
  173.     OutFile := OutputF;
  174.   end{GetFileNames};
  175.   {------------------------------------------------------------------}
  176.   procedure StartPass1;
  177.   begin
  178.     Display.InitCustom(LeftX, TopY, RightX, BottomY,
  179.                        DefaultColorSet,
  180.                        DefWindowOptions or wBordered);
  181.     with Display.wFrame do begin
  182.       AddShadow(shBR, shOverWrite);
  183.       AddHeader('Pass 1', heTC);
  184.     end;
  185.     Display.Draw;
  186.     Display.wFastText ('Input   : ' + InputF , 1, 1);
  187.     Display.wFastText ('Output  : ' + OutputF, 2, 1);
  188.     Display.wFastText ('Line #  : '          , 3, 1);
  189.   end{StartPass1};
  190.   {------------------------------------------------------------------}
  191.   procedure PutLineNumber (Number: LongInt);
  192.   begin
  193.     LastLine := Number;
  194.     Display.wFastText (Long2Str (Number), LinePut, 11);
  195.   end;
  196.   {------------------------------------------------------------------}
  197.   procedure StartPass2;
  198.   begin
  199.     Inc(BottomY);
  200.     Inc(LinePut);
  201.     Display.Done;
  202.     Display.InitCustom(LeftX, TopY, RightX, BottomY,
  203.                        DefaultColorSet,
  204.                        DefWindowOptions or wBordered);
  205.     with Display.wFrame do begin
  206.       AddShadow(shBR, shOverWrite);
  207.       AddHeader('Pass 2', heTC);
  208.     end;
  209.     Display.Draw;
  210.     Display.wFastText ('Input   : ' + InputF             , 1, 1);
  211.     Display.wFastText ('Output  : ' + OutputF            , 2, 1);
  212.     Display.wFastText ('# Lines : ' + Long2Str (LastLine), 3, 1);
  213.     Display.wFastText ('Line #  : '                      , 4, 1);
  214.   end{StartPass2};
  215.   {------------------------------------------------------------------}
  216.   procedure Finished (LastTopic : Word);
  217.   var
  218.     Key : Word;
  219.   begin
  220.     Display.ChangeHeader(0, 'Any key to continue');
  221.     Display.wFastText ('Last Topic : ' + Long2Str (LastTopic), 4, 1);
  222.     Key := ReadKeyWord;
  223.     Display.Done;
  224.   end{Finished};
  225.   {------------------------------------------------------------------}
  226. begin
  227.   {Initialize the ColorSet}
  228.   DefaultColorSet.SetFrameAttr         ($1F,AutoMapMono);
  229.   DefaultColorSet.SetHeaderAttr        ($1F,AutoMapMono);
  230.   DefaultColorSet.SetTextAttr          ($1F,AutoMapMono);
  231.   DefaultColorSet.SetFieldAttr         ($1F,AutoMapMono);
  232.   DefaultColorSet.SetPromptAttr        ($1F,AutoMapMono);
  233.   DefaultColorSet.SetSelectedPromptAttr($1F,AutoMapMono);
  234. end.
  235.